*
* $Id$
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.26  by  S.Giani
*-- Author :
      SUBROUTINE G3DRAW(NAME,UTHET,UPHI,UPSI,UU0,UV0,SU,SV)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       This routine draws the object called NAME, with its      *
C.    *       contents, at the screen point (UU0,UV0), with the        *
C.    *       screen factors SU and SV acting on the U and V           *
C.    *       dimensions respectively;                                 *
C.    *       the object is rotated by an angle UTHET along Y-axis     *
C.    *       and UPHI along Z-axis and the resulting 2-D picture      *
C.    *       is also rotated by an angle UPSI along the line of       *
C.    *       projection (i.e. the normal to the 2-D view plane).      *
C.    *                                                                *
C.    *       If IDRNUM<>0 then /GCVOLU/ is already filled by GLVOLU   *
C.    *       and a special case is handled (G3DRAW called by GDRVOL). *
C.    *                                                                *
C.    *    ==>Called by : <USER>, <GXINT>, G3DPRTR, G3DRAWC, G3DRAWX,  *
C.    *                   G3DSPEC                                      *
C.    *       Authors : R.Brun, A.McPherson, P.Zanarini,   *********   *
C.    *                 J.Salt, S.Giani                                *
C.    ******************************************************************
C.
***SG**************************************************************************
*                                                                             *
*      Most important improvements in this new version :                      *
*                                                                             *
*      Problems with the number of faces are solved, so that it's             *
*         possible to use all the memory available; moreover it's             *
*         now possible to use HIDE ON on CRAY-like machines;                  *
*                                                                             *
*      Problems with number of volumes now only depends upon the              *
*         size of Zebra store : a message will tell the number of             *
*         words you need more; problems in iterated drawings have             *
*         been solved too.                                                    *
*                                                                             *
*      A NEW SIZE EVALUATION is performed separately for Hide Structure and   *
*         Wire Structure with a resolution of 1 word ; this is the new logic: *
*         create immediately HIDE and WIRE structures and perform the         *
*         drawing WHILE evaluating the memory used; if memory booked in the   *
*         zebra store is not enough, then go on evaluating the number of      *
*         words needed and print it.                                          *
*                                                                             *
*      Multi-colour view of the different parts of a detector is now          *
*         available in Hidden Line Removal; a new bank is created for this.   *
*         Enjoy clipping now !!                                               *
*         Different line styles and width work as well !!                     *
*                                                                             *
*      Zooming is now possible in Hidden Line Removal too; Dspec works        *
*         even when Cvol is on and Seen attribute setting has been            *
*         optimized.                                                          *
*                                                                             *
*      Speed in drawing divided volumes can be increased by a factor about    *
*         linear with the number of volumes (a factor 30 for 900 tubes)!!!    *
*         At the same time, the number of words used can be decreased by a    *
*         factor 50!!! For example, in Gexam1 is possible to draw 22500 tubes *
*         using much less than 800000 words.                                  *
*                                                                             *
*      HIDDEN FACE REMOVAL algorithm has been implemented; it allows to       *
*         increase speed and decrease memory used by the same factors as      *
*         above for any kind of drawings!!! For example, it's now possible    *
*         to draw the complete L3 geometry using less than 3 Mwords (before   *
*         we needed 1 Gigabyte !!!)                                           *
*                                                                             *
*      The new command CVOL has been created: it allows to clip EACH          *
*         VOLUME in the detector by a different SHAPE; moreover, it's possible*
*         to clip twice each volume. You can clip each volume by the following*
*         shapes: BOX , TUBE, CONE, SPHE !                                    *
*                                                                             *
*      The new command SHIFT has been created: it allows to translate each    *
*         volume in the detector into a more visible place; for each volume,  *
*         the last shift you asked is performed.                              *
*                                                                             *
*      The option 'one' has been implemented in the shift command to allow    *
*         the shifting of a single copy for each volume; the new command      *
*         BOMB has been created to allow 'exploded' view of detectors.        *
*                                                                             *
*      A new bank is booked to create CG objects: it's now possible to draw   *
*         in HIDE ON the following shapes as well: PCON, TUBS, SPHE, TRAP     *
*         and Pyramids as TRAP having 4 edges in the same point. Moreover,    *
*         the new shape CTUB has been created even in hide on.                *
*                                                                             *
*      The number of words to draw TUBS, CONS, PCON, PGON can be decreased    *
*         even by a factor 10; moreover, several problems about edge visi-    *
*         bility have been solved.                                            *
*                                                                             *
*      A REFLECTION algorithm has been implemented for hidden line removal    *
*         as well; finally, a new logic scanning the geometrical tree has     *
*         been created to simulate, without alterate, the date structure.     *
*                                                                             *
*      A new SURFACE SHADING algorithm has been written to fill faces with    *
*         solid colours with varying intensity according to the light         *
*         inclination. Please see details in the documentation of the         *
*         routines which are concerned.                                       *
*                                                                             *
***SG**************************************************************************
*
#include "geant321/gcbank.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcdraw.inc"
#include "geant321/gconst.inc"
#include "geant321/gcnum.inc"
#include "geant321/gcmutr.inc"
#include "geant321/gcgobj.inc"
#if defined(CERNLIB_CG)
#include "geant321/cghpar.inc"
#endif
#include "geant321/gchiln.inc"
#include "geant321/gcspee.inc"
*
*    - The following common to be used by GXPICK
*
      COMMON /QUEST/ IQUEST(100)
      COMMON/GCVHLP/NVLAST
      COMMON/SP3D/ISPFLA
      COMMON/INIFIR/NFIRST
*
      CHARACTER*4 NAME,NAMEE2
      DIMENSION X(3),ATT(10)
      DIMENSION LVOLS(15),LINDX(15),LNAMES(15)
      DIMENSION GPAR(50,15)
#if defined(CERNLIB_CG)
      DIMENSION V(3),T(4,3)
#endif
      SAVE IFIRST, LFIRST
      DATA IFIRST,LFIRST/2*0/
*       Save info for GXPICK in case is needed
      CALL UCTOH(NAME, NVLAST, 4, 4)
***      CALL IGSET('SYNC',1.)
*
*       Hidden flag 'ON" (Default)
*
      CALL UCTOH('ON  ',IFLH,4,4)
*
***SG
*
      IF(NFIRST.EQ.0)THEN
        CALL GDCOTA
        NFIRST=1
      ENDIF
#if defined(CERNLIB_CG)
      IF(IHIDEN.EQ.IFLH)THEN
         IF(LFIRST.EQ.0) THEN
*      Link area for the banks
            CALL MZLINT(IXSTOR,'/GCHILN/',LARECG,ICLIP1,ICLIP2)
            LFIRST = 1
         ELSE
            IF(JCGCOL.NE.0) CALL MZDROP(IXSTOR, JCGCOL, ' ')
            IF(JCGOBJ.NE.0) CALL MZDROP(IXSTOR, JCGOBJ, ' ')
            IF(JCOUNT.NE.0) CALL MZDROP(IXSTOR, JCOUNT, ' ')
            IF(JCLIPS.NE.0) CALL MZDROP(IXSTOR, JCLIPS, ' ')
            IF(IMPOIN.NE.0) CALL MZDROP(IXSTOR, IMPOIN, ' ')
            IF(IMCOUN.NE.0) CALL MZDROP(IXSTOR, IMCOUN, ' ')
            IF(JSIX.NE.0) CALL MZDROP(IXSTOR, JSIX, ' ')
            IF(JSIY.NE.0) CALL MZDROP(IXSTOR, JSIY, ' ')
            IF(JSIZ.NE.0) CALL MZDROP(IXSTOR, JSIZ, ' ')
            IF(JPXC.NE.0) CALL MZDROP(IXSTOR, JPXC, ' ')
            IF(JPYC.NE.0) CALL MZDROP(IXSTOR, JPYC, ' ')
            IF(JPZC.NE.0) CALL MZDROP(IXSTOR, JPZC, ' ')
         ENDIF
         LARECG(1)=1
*
*                     Initialization
*
*  NWHS1: n. of words for Hide Structure
*  NWWS1: n. of words for Wire Structure
*  NWFLAG: Indicates if the size of CG bank is precise
*          =0 , it is
*          =-9, it isn't
*  IPAS: This flag indicates if the Size Evaluation has been performed
*        =0 , it does not
*        =1 , it does
*  NOBJ:  Counter of CG objects
*  NUVO:  Counter of CG volumes
*  II: Counter for volumes' line attributes
*  KGG: Flag for booking line attributes bank
*  LSTEP: Number of CG objects forming each volume
*  IFACST: Flag indicating final status of Hide Structure
*          =0 , it's ok
*          <0 , internal error
*          >0 , total number of words needed for Hide Structure
*  NCLAS2: Total number of volumes
*  S1...SS3: Min and Max values of volume scope
*  SRAGMX,SRAGMN: Max values of volume scope along R
*  NFILT= n. of words for HIDE+totalWIRE structures+CG+Line
*  NTCUR= n. of words for HIDE+instantWIRE structures+CG+Line
*  KSTART: Flag for Hidden Volume Removal
*  IOLDOL: Nlevel of last volume setting bounds for scope
*
*         NWHS1=0
*         NWWS1=0
*         NWFLAG=0
         IPER=0
         IPEOLD=0
         NOBJ=0
         NUVO=0
         IPAS=0
         II=0
         KGG=0
         LSTEP=1
         IFACST=0
*         IWORK=0
         NCLAS1=0
         NCLAS2=0
         NCLAS3=0
         IIIIII=0
*    Initialization of Hidden Volume and Face Removal
         S1=0
         S2=0
         S3=0
         SS1=0
         SS2=0
         SS3=0
         SRAGMX=0
         SRAGMN=0
         RAINT1=0
         RAINT2=0
         ISCOP=0
         KSTART=0
         IOLDOL=0
*    Initialisation for Shift
         NIET=0
         IOLDSU=0
         PORGX=0
         PORGY=0
         PORGZ=0
         DO 10  J=1,15
            POX(J)=0
            POY(J)=0
            POZ(J)=0
   10    CONTINUE
         DO 20  J=1,100
            IVECVO(J)=0
   20    CONTINUE
         IVOOLD=0
*         IMENO=0
         IPRELE=0
*    Resetting
         IHPOIN=0
         IWPOIN=0
         ICLIP1=0
         ICLIP2=0
         IVOLNA=0
         LPASS=0
         NWHS=0
         MFLA=0
         MVENLE=0
         MVECOL=0
         LFLA=0
         LVENLE=0
         LVEWID=0
         LFFLA=0
         LFENLE=0
         LVEFIL=0
         IXCG=IXSTOR+1
         JMEMT1=0
         JMEMT3=0
         JMEMT2=0
*    Resetting
         IF(JCG.NE.0)THEN
            CALL MZDROP(IXSTOR, JCG, ' ')
            CALL MZGARB(IXSTOR+1,0)
         ENDIF
*    Booking bank to create CG objects
         CALL MZNEED(IXCG,30000,'G')
         CALL MZBOOK(IXCG,JCGOBJ,JCGOBJ,1,'CGOB',0,0,30000,3,-1)
         CALL MZNEED(IXCG,33000,'G')
         CALL MZBOOK(IXCG,JCLIPS,JCLIPS,1,'CGCLIP',0,0,33000,3,-1)
         ICLIP1=JCLIPS+1
         ICLIP2=JCLIPS+16500
         JMEMT1=IQUEST(11)*.013
         IF(JMEMT1.LT.10000)JMEMT1=10000
         CALL MZNEED(IXCG,JMEMT1,'G')
         CALL MZBOOK(IXCG,JCOUNT,JCOUNT,1,'CGCONT',0,0,JMEMT1,2,-1)
         IQ(JCOUNT+1)=1
         IQ(JCOUNT+2)=4000
         IQ(JCOUNT+3)=8000
         LLEP=ABS(LEP)
         IF(LLEP.NE.1)THEN
            CALL MZNEED(IXCG,54000,'G')
            CALL MZBOOK(IXCG,JSIX,JSIX,1,'XGEN',0,0,9000,3,-1)
            CALL MZBOOK(IXCG,JSIY,JSIY,1,'YGEN',0,0,9000,3,-1)
            CALL MZBOOK(IXCG,JSIZ,JSIZ,1,'ZGEN',0,0,9000,3,-1)
            CALL MZBOOK(IXCG,JPXC,JPXC,1,'XPAR',0,0,9000,3,-1)
            CALL MZBOOK(IXCG,JPYC,JPYC,1,'YPAR',0,0,9000,3,-1)
            CALL MZBOOK(IXCG,JPZC,JPZC,1,'ZPAR',0,0,9000,3,-1)
            JMEMT3=JMEMT1
            CALL MZNEED(IXCG,JMEMT3,'G')
            CALL MZBOOK(IXCG,IMCOUN,IMCOUN,1,'SHCONT',0,0,JMEMT3,2,-1)
            IQ(IMCOUN+1)=1
            IQ(IMCOUN+2)=4000
            IQ(IMCOUN+3)=8000
            JMEMT2=IQUEST(11)*.1
            CALL MZNEED(IXCG,JMEMT2,'G')
            CALL MZBOOK(IXCG,IMPOIN,IMPOIN,1,'SHAFAC',0,0,JMEMT2,2,-1)
         ENDIF
*    Resetting
         CALL G3DCGRS
         NFILT=0
         NTCUR=0
         NTNEX=0
         NAIN=0
         ITSTCU=0
      ENDIF
#endif
*
***SG
C
C            Set IOBJ to VOLUME
C
      IOBJ=1
C
      IF (IFIRST.NE.0) GO TO 40
C
      IFIRST=1
      DPHI=PI/20.
      PHI=0.
C
      DO 30 I=1,40
         GSIN(I)=SIN(PHI)
         GCOS(I)=COS(PHI)
         PHI=PHI+DPHI
   30 CONTINUE
C
      GSIN(41)=GSIN(1)
      GCOS(41)=GCOS(1)
C
   40 CONTINUE
C
C             Save /GCVOLU/ if necessary
C
      IFCVOL=0
      IF (NLEVEL.NE.0) THEN
         CALL GSCVOL
         IFCVOL=1
      ENDIF
      IF (NLEVEL.LT.0) NLEVEL=IABS(NLEVEL)
C
C             If in cut-mode then open the G3DRAWV line buffer
C             else reset ICUT that could have been set by G3DRAWC/G3DRAWX
C
      IF (ICUTFL.EQ.1) THEN
         CALL G3DRAWV(0.,0.,-1)
      ELSE
         ICUT=0
      ENDIF
C
C             Start of general code
C
      CALL GLOOK(NAME,IQ(JVOLUM+1),NVOLUM,IVO)
      IF(IVO.LE.0)GO TO 280
C
C             Theta, phi and psi angles are normalized in [0-360[ range
C
 
      GTHETA=MOD(ABS(UTHET),360.)
      GPHI=MOD(ABS(UPHI),360.)
      GPSI=MOD(ABS(UPSI),360.)
      GU0=UU0
      GV0=UV0
      GSCU=SU
      GSCV=SV
      IMOD=0
*
#if defined(CERNLIB_CG)
*              Set Transformation Matrix T for CG Package
*
      IF(IHIDEN.EQ.IFLH)THEN
         V(1)=GTHETA
         V(2)=GPHI
         V(3)=GPSI
         CALL GDCGVW(V,T)
         CALL CGTSET(NTRCG,T,IREP)
         IF(IREP.EQ.-1)THEN
            WRITE(CHMAIL,10200)
            CALL GMAIL(0,0)
         ENDIF
         IF(IREP.EQ.-2)THEN
            WRITE(CHMAIL,10300)
            CALL GMAIL(0,0)
         ENDIF
*
*    Obtaining the IMOD flag for setting the run mode
*
         IF(IPAS.EQ.0)THEN
            IMOD=0
            IF(ICUT.NE.0)IMOD=1
            IF(IHOLE.EQ.1)IMOD=2
         ELSE
            IMOD=3
            IF(ICUT.NE.0)IMOD=4
            IF(IHOLE.EQ.1)IMOD=5
            IF(ICUT.NE.0.OR.IHOLE.EQ.1)THEN
               IFCG=4
               ILCG=3
            ENDIF
         ENDIF
      ENDIF
#endif
*JS
*  77  CONTINUE
      SINPSI=SIN(GPSI*DEGRAD)
      COSPSI=COS(GPSI*DEGRAD)
      GU0=UU0
      GV0=UV0
      NGVIEW=0
      JVO=LQ(JVOLUM-IVO)
C
C             Initialize JIN to switch correctly CALL GFPARA/GFIPAR
C
      JIN=0
C
      LEVSEE=1000
C
      IF (IDRNUM.NE.0) GO TO 70
C
C             Initialize for new geometry structure
C
      IF (JGPAR.EQ.0) CALL GMEDIN
      CALL G3LMOTH(NAME,1,NLEV,LVOLS,LINDX)
      DO 50 J=1, NLEV
         LNAMES(J)=IQ(JVOLUM+LVOLS(J))
   50 CONTINUE
      NLEV=NLEV+1
      CALL UCTOH(NAME,LNAMES(NLEV),4,4)
      LINDX(NLEV)=1
      DO 60   KLEV=2,NLEV
         JVOF = LQ(JVOLUM-LVOLS(KLEV-1))
         NIN  = Q(JVOF+3)
         IF(NIN.GT.0) THEN
            JIN = LQ(JVOF-LINDX(KLEV))
            ICOPY = Q(JIN+3)
         ELSE
            ICOPY = 1
         ENDIF
         LINDX(KLEV) = ICOPY
   60 CONTINUE
      CALL GLVOLU(NLEV, LNAMES, LINDX, IER)
C
      NLVTOP=NLEVEL
C
   70 CONTINUE
C
      NLMIN=NLEVEL
      NLMAX=NLEVEL
C
      IF (IDRNUM.NE.0) GO TO 110
C
      CALL G3FPARA(NAME,1,1,NPAR,NATT,GPAR(1,NLEVEL),ATT)
C
      IF (NPAR.LE.0) GO TO 290
C
      DO 100 LLL=1,NLEVEL
         DO 90 I=1,3
            GTRAN(I,LLL)=0.0
            X(I)=0.0
            DO 80 J=1,3
               K=(I-1)*3+J
               GRMAT(K,LLL)=0.0
   80       CONTINUE
            K=I*4-3
            GRMAT(K,LLL)=1.0
   90    CONTINUE
         GRMAT(10,LLL)=0.0
  100 CONTINUE
C
C             Ready for general case code
C
  110 CONTINUE
*SG
*    Taking volume name and shape from Zebra Structure
*
      IMENO=IVOLNA
      IVOLNA=IQ(JVOLUM+IVO)
      ISHAPE=Q(JVO+2)
*SG
      GSCU=SU
      GSCV=SV
C
      IF (IDRNUM.NE.0) GO TO 120
C
      IF (NLEVEL.EQ.NLVTOP) GO TO 130
C
  120 CONTINUE
C
      IF (IDRNUM.NE.0.AND.JIN.EQ.0) THEN
         CALL UHTOC(NAMES(NLEVEL),4,NAMEE2,4)
         CALL G3FPARA(NAMEE2,NUMBER(NLEVEL),1,NPAR,
     +            NATT,GPAR(1,NLEVEL),ATT)
      ELSE
         NPAR=Q(JVO+5)
         NATT=Q(JVO+6)
         JATT=JVO+7+NPAR
         CALL UCOPY(Q(JATT),ATT,NATT)
      ENDIF
C
  130 CONTINUE
C
      WORK=ATT(1)
      SEEN=ATT(2)
*
      LINSTY=ATT(3)
      LINWID=ATT(4)
      LINCOL=ATT(5)
      LINFIL=ATT(6)
      IF(LLEP.EQ.1)LINFIL=0
*SG
*    New logic setting the line attributes
*
      IF(NLEVEL.EQ.1)THEN
***               CALL GDCOTA
         IF(LINFIL.LT.0)THEN
            LINFIL=ABS(LINFIL)
            CALL ISFACI(LINFIL)
            CALL ISFAIS(1)
            CALL IGBOX(0.,20.,20.,0.)
            CALL ISFAIS(0)
            LINFIL=2
         ENDIF
      ENDIF
      IF(LINCOL.LT.2)THEN
         IF(MFLA.EQ.1.AND.NLEVEL.GT.MVENLE)LINCOL=MVECOL
         IF(NLEVEL.LE.MVENLE)MFLA=0
         IF(LINCOL.LT.0)THEN
            MVECOL=ABS(LINCOL)
            LINCOL=MVECOL
            MVENLE=NLEVEL
            MFLA=1
         ENDIF
      ENDIF
      IF(LINWID.LT.2)THEN
         IF(LFLA.EQ.1.AND.NLEVEL.GT.LVENLE)LINWID=LVEWID
         IF(NLEVEL.LE.LVENLE)LFLA=0
         IF(LINWID.LT.0)THEN
            LVEWID=ABS(LINWID)
            LINWID=LVEWID
            LVENLE=NLEVEL
            LFLA=1
         ENDIF
      ENDIF
      IF(LINFIL.LT.1)THEN
         IF(LFFLA.EQ.1.AND.NLEVEL.GT.LFENLE)LINFIL=LVEFIL
         IF(NLEVEL.LE.LFENLE)LFFLA=0
         IF(LINFIL.LT.0)THEN
            LVEFIL=ABS(LINFIL)
            LINFIL=LVEFIL
            LFENLE=NLEVEL
            LFFLA=1
         ENDIF
      ENDIF
*SG
      CALL MVBITS(LINCOL,0,8,LINATT,16)
      CALL MVBITS(LINWID,0,3,LINATT,7)
      CALL MVBITS(LINSTY,0,3,LINATT,10)
      CALL MVBITS(LINFIL,0,3,LINATT,13)
*
***SG
*
*    New logic scanning the geometrical tree:
*    A volume can set bounds OR be compared with bounds;
*    this can happen only IF a relationship mother-daughters exists.
*
*    Optimization for Hidden Volume and Face Removal:
*    POS and DIV cases are considered at the same time.
*
      IF(IPAS.EQ.0)GOTO 170
      IPORLI=0
      ISUBLI=0
      IF(KSTART.EQ.1)THEN
*
         IF(NLEVEL.GT.IOLDOL)THEN
            IF(LPASS.EQ.0)THEN
               ISUBLI=1
            ELSE
               IPORLI=1
               S1=0
               S2=0
               S3=0
               SS1=0
               SS2=0
               SS3=0
               SRAGMX=0
               SRAGMN=0
               RAINT1=0
               RAINT2=0
               ISCOP=0
               LPASS=0
               IF(SEEN.EQ.0.OR.SEEN.EQ.-1)LPASS=1
               IOLDOL=NLEVEL
            ENDIF
*
         ELSE IF(NLEVEL.LE.IOLDOL)THEN
            IPORLI=1
            S1=0
            S2=0
            S3=0
            SS1=0
            SS2=0
            SS3=0
            SRAGMX=0
            SRAGMN=0
            RAINT1=0
            RAINT2=0
            ISCOP=0
            LPASS=0
            IF(SEEN.EQ.0.OR.SEEN.EQ.-1)LPASS=1
            IOLDOL=NLEVEL
         ENDIF
*
         IF(NLEVEL.LE.IPRELE)THEN
            IF(IVOLNA.NE.IMENO)THEN
               NIET=2
               IF(SEEN.EQ.0.OR.IPORLI.EQ.1.OR.SEEN.EQ.-1)THEN
                  DO 140 I=1,15
                     IF((NLEVEL-I).GE.1)THEN
                        IF(POX(NLEVEL-I).NE.0.OR.POY(NLEVEL-I)
     +                  .NE.0.OR. POZ(NLEVEL-I).NE.0)THEN
                           PO1=POX(NLEVEL-I)
                           PO2=POY(NLEVEL-I)
                           PO3=POZ(NLEVEL-I)
                           GOTO 150
                        ENDIF
                     ENDIF
  140             CONTINUE
                  POX(NLEVEL)=0.
                  POY(NLEVEL)=0.
                  POZ(NLEVEL)=0.
                  PORGX=0.
                  PORGY=0.
                  PORGZ=0.
                  GOTO 160
  150             CONTINUE
                  POX(NLEVEL)=PO1
                  POY(NLEVEL)=PO2
                  POZ(NLEVEL)=PO3
               ENDIF
  160          CONTINUE
            ENDIF
         ENDIF
         IPRELE=NLEVEL
      ENDIF
*
      IF(IOLDOL.EQ.0.AND.(SEEN.EQ.1.OR.SEEN.EQ.-2
     +   .OR.SEEN.EQ.9))THEN
         KSTART=1
         IPORLI=1
         LPASS=0
         IOLDOL=NLEVEL
         IPRELE=NLEVEL
      ENDIF
  170 CONTINUE
*
***SG
*
C
C             WORK attribute enabled ?
C
      IF(WORK.LE.0.)GO TO 270
C
C             SEEN attribute processing
C
      IF (SEEN.LT.50.) GO TO 180
      ISEENL=SEEN/10.+0.5
      SEEN=ISEENL-10
  180 CONTINUE
      IF(NLEVEL.LE.LEVSEE)LEVSEE=1000
      IF(SEEN.EQ.-1.)GO TO 270
      IF (NLEVEL.GT.LEVSEE) GO TO 270
      IF(SEEN.EQ.0.)GO TO 220
      IF (SEEN.EQ.-2.) LEVSEE=NLEVEL
*JS
*
*     Logic has been modified  >>>>>
*
C
C       For the Standard Mode:  Draw the shape
C       For CG Mode : Make a CG-Object for each shape
C
      IF(IHIDEN.EQ.IFLH)THEN
*
*              CG Mode:
*
*
*  Case : divided without clipping
*
****SG
*      Optimization for setting seen attributes
*
         NIN=Q(JVO+3)
         IF(SEEN.EQ.9.AND.NIN.NE.0)THEN
            LPASS=1
            ITSTCU=0
            ICGP=0
            IIIIII=1
            GOTO 190
         ELSE
            IIIIII=0
         ENDIF
         IF(NIN.LT.0.AND.((ISHAPE.GT.1.AND.ISHAPE.LT.5).OR.
     +   (ISHAPE.GT.9.AND.ISHAPE.LT.13)))THEN
            IF(IPORLI.EQ.1)ISCOP=1
         ENDIF
         IF(SEEN.EQ.1.AND.NIN.LT.0)GOTO 190
         IF(SEEN.NE.-2.AND.NIN.LT.0.AND.(IMOD.EQ.0.OR.IMOD.EQ.3))
     +    GOTO 240
  190    CONTINUE
*
#if defined(CERNLIB_CG)
*
*      Creating, clipping and counting CG objects
*      Inserting the visible ones in Hide and Wire Structures
*
         IF(IIIIII.EQ.1)GOTO 200
         IMSE=IMOD
         IF(ISHAPE.EQ.11)LSTEP=GPAR(4,NLEVEL)-1
         IF(ISHAPE.EQ.12)LSTEP=GPAR(3,NLEVEL)-1
         CALL GDCGOB(IMSE,ISHAPE,GPAR(1,NLEVEL),NOBJ,NWWS,IVOLNA,
     +LSTEP)
  200    CONTINUE
         NOBJ=NOBJ+LSTEP
         NUVO=NUVO+1
         LSTEP=1
         IF(IPAS.NE.0)THEN
            IF(NCLAS2.GT.1000)THEN
               IPER=(100*NOBJ)/NCLAS2
               IF(IPER.EQ.10.OR.IPER.EQ.20.OR.IPER.EQ.30.OR.IPER.EQ.
     +         40.OR.IPER.EQ.50.OR.IPER.EQ.60.OR.IPER.EQ.70.OR.IPER
     +         .EQ.80.OR.IPER.EQ.90)THEN
                  IF(IPER.NE.IPEOLD)THEN
                     WRITE(CHMAIL,11800)IPER
                     CALL GMAIL(0,0)
                     IPEOLD=IPER
                  ENDIF
               ENDIF
            ENDIF
         ENDIF
*
*            Setting line attributes volume by volume
*
         IF(IHIDEN.EQ.IFLH) THEN
            IF(IPAS.NE.0.AND.KGG.EQ.1) THEN
**           IF(ITSTCU.NE.0.AND.IVFUN.NE.0) THEN
               IF((ITSTCU.NE.0).OR. ((ISHAPE.EQ.11.OR.ISHAPE.EQ.12)
     +         .AND.(ICGP.NE.0)))THEN
                  IF(ISHAPE.EQ.11.OR.ISHAPE.EQ.12)LSTEP=ICGP
                  LL=II+1
                  II=II+LSTEP
                  DO 210 KHH=LL,II
                     IQ(JCGCOL+KHH)=LINATT
  210             CONTINUE
                  LSTEP=1
               ENDIF
            ENDIF
         ENDIF
*
*
*      Logic has been modified again :
*      do the size evaluation while creating Hide Structure
*      do the same for Wire Structure
*
*      If number of words booked for Hide Structure or for
*      Wire Structure is not sufficient, then evaluate the
*      the right number of words needed and send a mail.
*
         IF(KCGST.EQ.-9)THEN
*
*      Ten words more for safety
*
            NWHS1 = NCLAS1+ 10
            CALL CGHEVA(Q(IHPOIN),HISI)
            IF(HISI.GT.NWHS1)NWHS1=HISI
            IWORH = NWHS1 - NWHS
            IWORH1= IWORH * 1.666666
            WRITE(CHMAIL,11500)IWORH1
            CALL GMAIL(0,0)
            GOTO 320
         ELSE IF(KCGST.EQ.-10)THEN
            NWWS1 = NCLAS3+ 10
            IWORW = NWWS1 - NWWS
            IWORW1= IWORW * 2.5
            WRITE(CHMAIL,11400)IWORW1
            CALL GMAIL(0,0)
            GOTO 320
         ELSEIF(KCGST.EQ.-4.OR.KCGST.EQ.-1.OR.KCGST.EQ.-2) THEN
*      Exiting without having made evaluation of size
            GOTO 320
         ENDIF
****SG
*    Case: Volume placed by GSPOS, not clipped and 'closed'
*
*XX
*         IF(NIN.GT.0.AND.(IMOD.EQ.0.OR.IMOD.EQ.3).
*     +   AND.KSHIFT.EQ.0.AND.GBOOM.EQ.0.)  GOTO 150
*XX
#endif
      ELSE
*
*              Standard Mode: Draw the shape
*
         CALL IGPID(1,'Pick',IVO,' ')
         CALL IGPID(2,'Pick',IQ(JVOLUM+IVO),' ')
         IF (ICUTFL.EQ.1) THEN
            CALL GDRWSC(ISHAPE,GPAR(1,NLEVEL))
         ELSE
            CALL G3DRAWS(ISHAPE,GPAR(1,NLEVEL))
         ENDIF
*
      ENDIF
*JS
      JVO=LQ(JVOLUM-IVO)
C
      IF(SEEN.EQ.-2.)GO TO 270
C
  220 CONTINUE
C
***   IF (IDRNUM.NE.0) GO TO 999
C
C             Skip User shapes (not yet implemented)
C
**      ISEARC=Q(JVO+1)
C
C             Now go down the tree
C
      NIN=Q(JVO+3)
      IF(NIN.EQ.0) GO TO 270
      IF(NIN.LT.0) GO TO 240
C
C             Contents placed by GSPOS
C
      IN=0
      IF(NLMAX.GT.NLEVEL) IN=LINDEX(NLEVEL+1)
      IN=IN+1
      IF(IN.GT.NIN.AND.NLEVEL.EQ.NLMIN) GO TO 300
*
      IF(IN.GT.NIN) GO TO 260
*
      CALL GMEPOS(JVO,IN,X,0)
      JIN = LQ(JVO-IN)
*
      NPAR=IQ(JGPAR+NLEVEL)
      DO 230 I=1,NPAR
         GPAR(I,NLEVEL)=Q(LQ(JGPAR-NLEVEL)+I)
  230 CONTINUE
*
      IVO=LVOLUM(NLEVEL)
      JVO=LQ(JVOLUM-IVO)
      NLMAX=NLEVEL
      GO TO 110
C
  240 CONTINUE
C
C             Contents by division
C
      IN=0
      IF(NLMAX.GT.NLEVEL) IN=LINDEX(NLEVEL+1)
      IN=IN+1
      CALL GMEDIV(JVO,IN,X,0)
      JIN = LQ(JVO-IN)
*
      IF (IN.EQ.0) GO TO 260
*
      NPAR=IQ(JGPAR+NLEVEL)
      DO 250 I=1,NPAR
         GPAR(I,NLEVEL)=Q(LQ(JGPAR-NLEVEL)+I)
  250 CONTINUE
*
      IF (IN.EQ.0) GO TO 260
*
      IVO=LVOLUM(NLEVEL)
      JVO=LQ(JVOLUM-IVO)
      NLMAX=NLEVEL
      GO TO 110
C
  260 CONTINUE
      NLMAX=NLEVEL
  270 CONTINUE
      NLEVEL=NLEVEL-1
      IF(NLEVEL.LT.NLMIN) GO TO 300
      IVO=LVOLUM(NLEVEL)
      JVO=LQ(JVOLUM-IVO)
      GO TO 220
C
  280 WRITE(CHMAIL,10000)NAME
      CALL GMAIL(0,0)
      GO TO 300
C
  290 CONTINUE
C
C             TOP OF THE TREE HAS PARAMETERS SET BY GSPOSP.
C             BUT G3DRAW DOES NOT HAVE ACCESS TO THE IN BANK
C             WHICH PLACED IT IN ITS MOTHER.
C
      WRITE(CHMAIL,10100) NAME
      CALL GMAIL(0,0)
C
  300 CONTINUE
*
***SG
*
#if defined(CERNLIB_CG)
*
*  CG Mode
*
      IF(IHIDEN.EQ.IFLH) THEN
*
*    In CG Mode the program flow has two scanning of the geometrical tree:
*    the first one is to count the number of volumes (IPAS=0);
*    the second one is to compute volumes' visibility with Hidden Volume
*    and Face Removal, inserting them in the Hide and Wire structures if
*    the size of Zebra store is sufficient (IPAS=1).
*
         IF(IPAS.EQ.0)THEN
*
*    Creating a bank for setting line attributes volume by volume.
*    The number of words needed is just equal to the total number
*      of visible volumes.
*
            NCLAS2=NOBJ
            IF(KGG.EQ.0)THEN
               CALL MZNEED(IXCG,NCLAS2+10,'G')
*
*    Take everything is left but leave 100,000 words just in case
*
               MEMO=IQUEST(11)-(IQUEST(11)*.11)
               IF(IQUEST(11).LE.0)THEN
                  WRITE(CHMAIL,11300)NCLAS2+10
                  CALL GMAIL(0,0)
                  GOTO 320
               ENDIF
               CALL MZBOOK(IXCG,JCGCOL,JCGCOL, 1,'LINE',0,0,NCLAS2+10,
     +         2,-1)
            ENDIF
            KGG=KGG+1
            NOBJ=0
            NUVO=0
            IPAS=1
*
            NFILT=63000+NCLAS2+10
*
*    Use max Zebra store for Hide and Wire structures
*
            NWHS=0.6*MEMO
            NWWS=0.4*MEMO
            CALL MZBOOK(IXCG,JCG,JCG,1,'CG',0,0,MEMO,3,-1)
            CALL G3DCGRS
*
            IHS=1
            IHPOIN=JCG+1
*
*    Creating the Hidden Structure
*
            IF(NWHS.LE.LHHEAD)NWHS=LHHEAD+1
***SG
            CALL CGHCRE(NTRCG,0,DUMMY,DUMMY,NWHS,Q(IHPOIN))
            NTCUR=NWHS
            IOLDCU=NTCUR
            NFILT=NFILT+NTCUR
            GOTO 40
         ENDIF
         IF(NOBJ.EQ.0)GOTO 320
****SG
*    Closing the Hidden Structure
*
         IHPOIN=JCG+1
*
*     Last size evaluation for Hide Structure
*
         CALL CGHEND(Q(IHPOIN),IFACST,RSHD)
         IF(IFACST.GT.0)THEN
            NWHS1 = IFACST+ 10
            IWORH = NWHS1 - NWHS
            IWORH1= IWORH * 1.666666
            WRITE(CHMAIL,11500)IWORH1
            CALL GMAIL(0,0)
            GOTO 320
         ENDIF
*
* IFACST shouldn't be negative now
*
         IF(IFACST.LT.0)THEN
            WRITE(CHMAIL,10500)
            CALL GMAIL(0,0)
            GOTO 320
         ENDIF
*
*     Setting the right colours
*               and
*     Drawing the CG Objects
*
         IF(ILCG.LT.IFCG)THEN
            WRITE(CHMAIL,10400)
            CALL GMAIL(0,0)
         ELSE
            IF(LEP.GE.0.AND.ISPFLA.NE.1)THEN
               WRITE(CHMAIL,11900)
               CALL GMAIL(0,0)
            ENDIF
***            call write_dxf_sect_entity( 1 )
            DO 310 K=IFCG,ILCG
               IF(IDVIEW.NE.0)THEN
                  IF(ILCG.GT.1000)THEN
                     IPER=(100*K)/ILCG
                     IF(IPER.EQ.10.OR.IPER.EQ.20.OR.IPER.EQ.30.OR.IPER.
     +               EQ. 40.OR.IPER.EQ.50.OR.IPER.EQ.60.OR.IPER.EQ.70.O
     +               R.IPER .EQ.80.OR.IPER.EQ.90)THEN
                        IF(IPER.NE.IPEOLD)THEN
                           WRITE(CHMAIL,12000)IPER
                           CALL GMAIL(0,0)
                           IPEOLD=IPER
                        ENDIF
                     ENDIF
                  ENDIF
               ENDIF
               LINATT=IQ(JCGCOL+K-IFCG+1)
               IWPOIN=JCG+IQ(JCOUNT+K)
               IF(ISPFLA.EQ.1)ISPFLA=2
               IF(LLEP.NE.1)THEN
                  MMPOIN=IMPOIN+IQ(IMCOUN+K)
                  CALL GD16V((IQ(JCOUNT+K)-1),IQ(MMPOIN))
               ELSE
                  CALL GD16V((IQ(JCOUNT+K)-1),0)
               ENDIF
               IF(ISPFLA.EQ.2)ISPFLA=1
  310       CONTINUE
         ENDIF
***        call write_dxf_sect_entity( 2 )
*
*    Printing statistics
*
         IF(LEP.GE.0.AND.ISPFLA.NE.1)THEN
            NFILT=NFILT-NWHS+RSHD
            INFILT=NFILT
            IRSHD=RSHD
            MEMO1=MEMO+63000+NCLAS2+10+JMEMT2+JMEMT1+JMEMT3+54000
            RSWR =NFILT-RSHD-63000-NCLAS2-10
            IRSWR=RSWR
            ICGOB=63000
            RATIO=RSHD/RSWR
            JJIIKK=0
            JPARGE=0
            IF(LLEP.NE.1)THEN
               JJIIKK=ILCG-IFCG+1
               JPARGE=54000
            ENDIF
            WRITE(CHMAIL,10600)INFILT+NTNEX+ILCG-IFCG+1+JJIIKK+JPARGE
            CALL GMAIL(0,0)
            WRITE(CHMAIL,10700)MEMO1
            CALL GMAIL(0,0)
            WRITE(CHMAIL,10900)NCLAS2+10
            CALL GMAIL(0,0)
            WRITE(CHMAIL,10800)ICGOB
            CALL GMAIL(0,0)
            WRITE(CHMAIL,11000)IRSHD
            CALL GMAIL(0,0)
            WRITE(CHMAIL,11100)IRSWR+ILCG-IFCG+1
            CALL GMAIL(0,0)
            WRITE(CHMAIL,11200)NTNEX+JJIIKK+JPARGE
            CALL GMAIL(0,0)
*         WRITE(CHMAIL,10799)RATIO
*         CALL GMAIL(0,0)
            WRITE(CHMAIL,11600)ILCG-IFCG+1
            CALL GMAIL(0,0)
            WRITE(CHMAIL,11700)NCLAS2
            CALL GMAIL(0,0)
         ENDIF
*
      ENDIF
*
*    Dropping + resetting parameters
*
  320 CONTINUE
      IF(IHIDEN.EQ.IFLH)THEN
         ICUT=0
         IF(JCG.NE.0)CALL MZDROP(IXSTOR,JCG,' ')
         IF(JCGOBJ.NE.0)CALL MZDROP(IXSTOR,JCGOBJ,' ')
         CALL G3DCGRS
         IF(JCGCOL.NE.0)CALL MZDROP(IXSTOR,JCGCOL,' ')
         IF(JCOUNT.NE.0)CALL MZDROP(IXSTOR,JCOUNT,' ')
         IF(JCLIPS.NE.0)CALL MZDROP(IXSTOR,JCLIPS,' ')
         IF(IMPOIN.NE.0)CALL MZDROP(IXSTOR,IMPOIN,' ')
         IF(IMCOUN.NE.0)CALL MZDROP(IXSTOR,IMCOUN,' ')
         IF(JSIX.NE.0) CALL MZDROP(IXSTOR, JSIX, ' ')
         IF(JSIY.NE.0) CALL MZDROP(IXSTOR, JSIY, ' ')
         IF(JSIZ.NE.0) CALL MZDROP(IXSTOR, JSIZ, ' ')
         IF(JPXC.NE.0) CALL MZDROP(IXSTOR, JPXC, ' ')
         IF(JPYC.NE.0) CALL MZDROP(IXSTOR, JPYC, ' ')
         IF(JPZC.NE.0) CALL MZDROP(IXSTOR, JPZC, ' ')
         LARECG(1)=0
         CALL MZGARB(IXSTOR+1,0)
*         NWHS1=0
*         NWFLAG=0
         NCLAS1=0
         NCLAS2=0
         NCLAS3=0
      ENDIF
*
****SG
*
#endif
      IF (IFCVOL.EQ.1) THEN
         CALL GFCVOL
      ELSE
         NLEVEL=0
      ENDIF
C
C             If in cut-mode then close the G3DRAWV line buffer
C
      IF (ICUTFL.EQ.1) CALL G3DRAWV(0.,0.,0)
C
C             Restore permanent value of color and return
C
*      CALL G3DCOL(0)
      IOBJ=0
C
10000 FORMAT(' *** G3DRAW *** : Volume ',A4,' does not exist')
10100 FORMAT(' *** G3DRAW *** : Top of tree ',A4,' parameters defined',
     +       '  by GSPOSP - info not available to G3DRAW.')
10200 FORMAT(' *** G3DRAW *** : Illegal Transformation Matrix',
     +       ' Number NTRCG ')
10300 FORMAT(' *** G3DRAW *** :  >>> Det (T) = 0  ')
10400 FORMAT(' *** G3DRAW *** :  Warning! Volume is destroyed.')
*SG
10500 FORMAT(' *** G3DRAW *** :  Internal error, please report to',
     +       ' GEANT support team')
10600 FORMAT(' *** G3DRAW *** : Total memory used    =',I10,' words.')
10700 FORMAT(' *** G3DRAW *** : Total memory booked  =',I10,' words.')
10800 FORMAT(' *** G3DRAW *** : Memory used for CGOB =',I10,' words.')
10900 FORMAT(' *** G3DRAW *** : Memory used for LINE =',I10,' words.')
11000 FORMAT(' *** G3DRAW *** : Memory used for HIDE =',I10,' words.')
11100 FORMAT(' *** G3DRAW *** : Memory used for WIRE =',I10,' words.')
11200 FORMAT(' *** G3DRAW *** : Memory used for SHAD =',I10,' words.')
11300 FORMAT(' *** G3DRAW *** : Memory needed for the LINE attributes',
     +       ' =',I10,' words.')
*10799 FORMAT(' *** G3DRAW *** : HIDE/WIRE=',F4.2,'.')
11400 FORMAT(' *** G3DRAW *** : Please, increase size of Zebra store',
     +       ' by',I10,' words to create WIRE structure.')
11500 FORMAT(' *** G3DRAW *** : Please, increase size of Zebra store',
     +       ' by',I10,' words to create HIDE structure.')
11600 FORMAT(' *** G3DRAW *** : Visible volumes      =',I10,'.')
11700 FORMAT(' *** G3DRAW *** : Total   volumes      =',I10,'.')
11800 FORMAT(' *** G3DRAW *** :',I2,'% of volumes analysed.')
11900 FORMAT(' *** G3DRAW *** : Now the drawing is starting !')
12000 FORMAT(' *** G3DRAW *** :',I2,'% of volumes drawn.')
*
*SG
      END
